home *** CD-ROM | disk | FTP | other *** search
/ Aminet 15 / Aminet 15 - Nov 1996.iso / Aminet / text / dtp / PicCatalog203.lha / PicCatalog203.rexx < prev   
OS/2 REXX Batch file  |  1996-09-25  |  20KB  |  636 lines
  1. /*--------------------------------------*/
  2. /* $VER: PicCatalog V2.03 (25 Sep 1996) */
  3. /* ©1996 Michael Merkel                 */
  4. /*--------------------------------------*/
  5.  
  6. /*
  7.    how to use this:
  8.    ----------------
  9.  
  10.    1. open a new document
  11.    2. start this script
  12.    3. select a picture directory
  13.    4. press "make"
  14.  
  15.  
  16.    comments to this program to:
  17.    ----------------------------
  18.       mmerkel@rummelplatz.uni-mannheim.de
  19.  
  20.    Regards...
  21.    Michael Merkel
  22. */
  23.  
  24. OPTIONS RESULTS
  25.  
  26. /* Make sure rexx support is opened */
  27. IF ~SHOW('L','rexxsupport.library') THEN
  28.    CALL ADDLIB('rexxsupport.library',0,-30)
  29. IF ~SHOW('L','softlogik:libs/slarexxsupport.library') THEN
  30.    CALL ADDLIB('softlogik:libs/slarexxsupport.library',0,-30)
  31. ADDRESS 'PAGESTREAM'
  32.  
  33. /* defaults */
  34.  
  35. 'GETPAGEMASTERPAGE MASTERPAGE mname'
  36. if (RC = 10) then call DOERRORREQUESTER
  37.  
  38. 'GETDIMENSIONS dim MASTERPAGE "'mname'"'
  39. if (dim.orientation = 'PORTRAIT') then do
  40.     rpagesizex = dim.width
  41.     rpagesizey = dim.height
  42.     end
  43. else do
  44.     rpagesizex = dim.height
  45.     rpagesizey = dim.width
  46. end
  47.  
  48. measure = 'pt'
  49. tf.0 = 'FALSE'
  50. tf.1 = 'TRUE'
  51. call ReadPrefs
  52.  
  53. /* get user choices */
  54.  
  55.  call DOREQUESTER
  56.  if (ergebnis = cancelhandler) then EXIT
  57.  call WritePrefs
  58.  
  59. /* transform to same measurement system */
  60.  
  61. pagesizex = p2d(rpagesizex,measure)
  62. pagesizey = p2d(rpagesizey,measure)
  63. leftgap = p2d(rleftgap,measure)
  64. topgap = p2d(rtopgap,measure)
  65. rightgap = p2d(rrightgap,measure)
  66. bottomgap = p2d(rbottomgap,measure)
  67. gap = p2d(rgap,measure)
  68. txtsize = p2d(rtxtsize,measure)
  69. psx = (pagesizex-leftgap-rightgap-(numx-1)*gap) / numx
  70. psy = (pagesizey-topgap-bottomgap-(numy-1)*gap-numy*txtsize) / numy
  71. psf = psx / psy
  72. anzp = numx * numy
  73.  
  74. if (Open('dump','T:PicCatalog.dumpfile','W') = 1) then do
  75.     wl=WriteLN('dump','DUMPFILE for PicCatalog V2.03 - ©1996 Michael Merkel')
  76.     cl=Close('dump')
  77. end
  78.  
  79. num = 0
  80.  
  81. /* draw border for first page */
  82. call DrawPageBorder
  83.  
  84. 'OPENBUSYREQUESTER MESSAGE "getting pictures ..." THERMOMETER DISABLED ABORT ENABLED'
  85.  BusyReq=result
  86.  
  87. 'REFRESH OFF'
  88.  
  89. dummy = RekDir(pdir)
  90.  
  91. if ((num // anzp) ~= 0) then do
  92.     call DrawPageBorder
  93.  
  94.     if (print = 1) then do
  95.         'REFRESH ON'
  96.         'REFRESHWINDOW'
  97.         call PrintPage
  98.     end
  99.   end
  100. else do
  101.     'SELECTOBJECT ALL'
  102.     'DELETEOBJECT'
  103.     'DISPLAY PAGE PREVIOUS'
  104. end
  105.  
  106. call CLEANUP
  107.  
  108. AddPicture:
  109.     ARG name
  110.  
  111.     call DumpText('('||num||') '||name||' -> ',0)
  112.  
  113.     /* bitmappictures! */
  114.     pictype = 1
  115.     CALL getbusy(name)
  116. /* this prevents ARexx to show error messages (RC=10) if pictype is wrong */
  117. OPTIONS FAILAT 11
  118.     RC = 1
  119.     if (liff = 1) then
  120.         if (RC ~= 0) then 'PLACEGRAPHIC FILE "'name'" FILTER "IFFILBM" PROGRESS'
  121.     if (lgif = 1) then
  122.         if (RC ~= 0) then 'PLACEGRAPHIC FILE "'name'" FILTER "GIF" PROGRESS'
  123.     if (ljpeg = 1) then
  124.         if (RC ~= 0) then 'PLACEGRAPHIC FILE "'name'" FILTER "JPEG" PROGRESS'
  125.     if (RC ~= 0) then do
  126.         /* drawings! */
  127.         pictype = 2
  128.         if (leps = 1) then
  129.             if (RC ~= 0) then 'PLACEGRAPHIC FILE "'name'" FILTER "ILLUSTRATOREPS" PROGRESS'
  130.         if (ldr2d = 1) then
  131.             if (RC ~= 0) then 'PLACEGRAPHIC FILE "'name'" FILTER "IFFDR2D" PROGRESS'
  132.         if (laeeps = 1) then
  133.             if (RC ~= 0) then 'PLACEGRAPHIC FILE "'name'" FILTER "ARTEXPRESSIONEPS" PROGRESS'
  134.     end
  135. OPTIONS FAILAT 10
  136.     if (RC = 0) then do
  137.         if (pictype = 1) then 'GETPICTURE POSITION 'posi
  138.         else                  'GETDRAWING POSITION 'posi
  139.         picid = RESULT
  140.         width = p2d(posi.right,measure) - p2d(posi.left,measure)
  141.         height = p2d(posi.bottom,measure) - p2d(posi.top,measure)
  142.         gsf = width / height
  143.         if (gsf > psf) then factor = psx / width
  144.         else                factor = psy / height
  145.  
  146.         newwidth = factor * width
  147.         newheight = factor * height
  148.  
  149.         centerdeltax = (psx - newwidth) / 2
  150.         centerdeltay = (psy - newheight) / 2
  151.  
  152.         newl = leftgap + (num // numx) * (psx+gap) + centerdeltax
  153.         newt = topgap + ((num // anzp) %  numx) * (psy+gap+txtsize) + centerdeltay
  154.         newr = newl + newwidth
  155.         newb = newt + newheight
  156.  
  157.         d1 = leftgap + (num // numx) * (psx+gap)
  158.         d2 = topgap + ((num // anzp) % numx) * (psy+gap+txtsize)
  159.         d3 = d1 + psx
  160.         d4 = d2 + psy
  161.  
  162.         'DRAWBOX 'd1||measure d2||measure d3||measure d4||measure
  163.         'SETSTROKEWEIGHT 2pt'
  164.  
  165.         if (pictype = 1) then 'EDITPICTURE POSITION 'newl||measure newt||measure newr||measure newb||measure' stored "EXTERNAL" OBJECTID 'picid
  166.         else                  'EDITDRAWING POSITION 'newl||measure newt||measure newr||measure newb||measure' stored "EXTERNAL" OBJECTID 'picid
  167.  
  168.         if (txtsize > 0) then do
  169.             'DRAWTEXTOBJ 'd1||measure' 'd4||measure' INFRONT'
  170.              txtid = RESULT
  171.             'SELECTTEXT AT 'd1||measure' 'd4||measure' FRONTMOST'
  172.             'SETTYPESIZE 'txtsize
  173.             'SETPARAGRAPHSTYLE "PicName"'
  174.             if (prname = 0) then 'INSERT "'name'"'
  175.             else do
  176.                 name2 = reverse(name)
  177.                 pos = pos('/',name2)
  178.                 if (pos = 0) then pos = pos(':',name2)
  179.                 name3 = right(name,pos-1)
  180.                 'INSERT "'name3'"'
  181.             end
  182.             'GETTEXTOBJ POSITION txtpos OBJECTID 'txtid
  183.             txtp2.left   = p2d(txtpos.left,measure)
  184.             txtp2.top    = p2d(txtpos.top,measure)
  185.             txtp2.bottom = p2d(txtpos.bottom,measure)
  186.             txtp2.right  = p2d(txtpos.right,measure)
  187.  
  188.             txtwidth = txtp2.right - txtp2.left
  189.             if (txtwidth > psx) then 'EDITTEXTOBJ POSITION 'txtp2.left||measure' 'txtp2.top||measure' 'd3||measure' 'txtp2.bottom||measure' OBJECTID 'txtid
  190.         end
  191.  
  192.         CALL DumpText('....created',1)
  193.  
  194.         num = num + 1
  195.         if ((num // anzp) == 0) then do    /* letztes Bild auf Seite bearbeitet */
  196.             'REFRESH ON'
  197.             'REFRESHWINDOW'
  198.             if (print = 1) then call PrintPage
  199.             else do
  200.                 'DISPLAY PAGE NEXT'
  201.             end
  202.             call DrawPageBorder
  203.             'REFRESH OFF'
  204.         end
  205.     end
  206.     else call DumpText('....NOT created',1)
  207. RETURN
  208.  
  209. DOREQUESTER:
  210.     filehandler = 0
  211.     ergebnis = filehandler
  212.     do until ((ergebnis = okhandler) | (ergebnis = cancelhandler))
  213.         'ALLOCAREXXREQUESTER "PicCatalog V2.03 - ©1996 Michael Merkel" 350 280'
  214.          reqhandle = RESULT
  215.         'ADDAREXXGADGET 'reqhandle' EXIT 10  260 70 LABEL "_Make"'
  216.          okhandler = RESULT
  217.         'ADDAREXXGADGET 'reqhandle' EXIT 270 260 70 LABEL "_Cancel"'
  218.          cancelhandler = RESULT
  219.         'ADDAREXXGADGET 'reqhandle' EXIT 115 260 120 LABEL "_Print Settings"'
  220.          pprefshandler = RESULT
  221.  
  222.         'ADDAREXXGADGET 'reqhandle' STRING 215  5  55 STRING "'numx'" LABEL "# of pictures horizontal:"'
  223.          numx_gadget = RESULT
  224.         'ADDAREXXGADGET 'reqhandle' STRING 215 20  55 STRING "'numy'" LABEL "# of pictures vertical:  "'
  225.          numy_gadget = RESULT
  226.  
  227.         'ADDAREXXGADGET 'reqhandle' STRING 95 40  70 STRING "'rleftgap'"  LABEL "left gap: "'
  228.          rleftgap_gadget = RESULT
  229.         'ADDAREXXGADGET 'reqhandle' STRING 95 55  70 STRING "'rrightgap'" LABEL "right gap:"'
  230.          rrightgap_gadget = RESULT
  231.         'ADDAREXXGADGET 'reqhandle' STRING 270 40 70 STRING "'rtopgap'"    LABEL "top gap:   "'
  232.          rtopgap_gadget = RESULT
  233.         'ADDAREXXGADGET 'reqhandle' STRING 270 55 70 STRING "'rbottomgap'" LABEL "bottom gap:"'
  234.          rbottomgap_gadget = RESULT
  235.  
  236.         'ADDAREXXGADGET 'reqhandle' STRING 183  80  50 STRING "'rgap'" LABEL "gap between pictures:"'
  237.          rgap_gadget = RESULT
  238.  
  239.         'ADDAREXXGADGET 'reqhandle' STRING 183  100 50 STRING "'rtxtsize'" LABEL "textsize (0 = none): "'
  240.          rtxtsize_gadget = RESULT
  241.  
  242.         'ALLOCAREXXLIST'
  243.          rexxlist = RESULT
  244.         'ADDAREXXLIST 'rexxlist' "full path"'
  245.         'ADDAREXXLIST 'rexxlist' "name only"'
  246.         'ADDAREXXGADGET 'reqhandle' CYCLE 240 100 100'
  247.          prname_gadget = RESULT
  248.         'SETAREXXGADGET 'reqhandle' 'prname_gadget' LIST 'rexxlist' CURRENT 'prname
  249.  
  250.         'ADDAREXXGADGET 'reqhandle' STRING 10  130 300 STRING "'pdir'" LABEL "picture path:" LABELPOS "ABOVELEFT"'
  251.          pdir_gadget = RESULT
  252.         'ADDAREXXGADGET 'reqhandle' EXIT   315 130 10  LABEL "?"'
  253.          filehandler = RESULT
  254.         'ADDAREXXGADGET 'reqhandle' CHECKBOX 10  150 10  CHECKED "'tf.lreku'" LABEL "do directories recursive"'
  255.          lreku_gadget = RESULT
  256.  
  257.         'ADDAREXXGADGET 'reqhandle' CHECKBOX 10  180 10  CHECKED "'tf.liff'" LABEL "load IFF"'
  258.          liff_gadget = RESULT
  259.         'ADDAREXXGADGET 'reqhandle' CHECKBOX 110 180 10  CHECKED "'tf.lgif'" LABEL "load GIF"'
  260.          lgif_gadget = RESULT
  261.         'ADDAREXXGADGET 'reqhandle' CHECKBOX 210 180 10  CHECKED "'tf.ljpeg'" LABEL "load JPEG"'
  262.          ljpeg_gadget = RESULT
  263.         'ADDAREXXGADGET 'reqhandle' CHECKBOX 10  200 10  CHECKED "'tf.ldr2d'" LABEL "load DR2D"'
  264.          ldr2d_gadget = RESULT
  265.         'ADDAREXXGADGET 'reqhandle' CHECKBOX 110 200 10  CHECKED "'tf.leps'" LABEL "load EPS"'
  266.          leps_gadget = RESULT
  267.         'ADDAREXXGADGET 'reqhandle' CHECKBOX 210 200 10  CHECKED "'tf.laeeps'" LABEL "load AEEPS"'
  268.          laeeps_gadget = RESULT
  269.  
  270.         'ADDAREXXGADGET 'reqhandle' CHECKBOX 10  230 10  CHECKED "'tf.print'" LABEL "print every single page"'
  271.          print_gadget = RESULT
  272.         'ADDAREXXGADGET 'reqhandle' TEXT     30  240 240 STRING "(instead of collecting them)"'
  273.  
  274.         'DOAREXXREQUESTER 'reqhandle
  275.          ergebnis = RESULT
  276.  
  277.         'GETAREXXGADGET 'reqhandle' 'numx_gadget' STRING'
  278.          numx = RESULT
  279.         'GETAREXXGADGET 'reqhandle' 'numy_gadget' STRING'
  280.          numy = RESULT
  281.  
  282.         'GETAREXXGADGET 'reqhandle' 'rleftgap_gadget' STRING'
  283.          rleftgap = RESULT
  284.         'GETAREXXGADGET 'reqhandle' 'rtopgap_gadget' STRING'
  285.          rtopgap = RESULT
  286.         'GETAREXXGADGET 'reqhandle' 'rrightgap_gadget' STRING'
  287.          rrightgap = RESULT
  288.         'GETAREXXGADGET 'reqhandle' 'rbottomgap_gadget' STRING'
  289.          rbottomgap = RESULT
  290.  
  291.         'GETAREXXGADGET 'reqhandle' 'rgap_gadget' STRING'
  292.          rgap = RESULT
  293.         'GETAREXXGADGET 'reqhandle' 'rtxtsize_gadget' STRING'
  294.          rtxtsize = RESULT
  295.         'GETAREXXGADGET 'reqhandle' 'prname_gadget' CURRENT'
  296.          prname = RESULT
  297.         'GETAREXXGADGET 'reqhandle' 'pdir_gadget' STRING'
  298.          pdir = RESULT
  299.         'GETAREXXGADGET 'reqhandle' 'lreku_gadget' CHECKED'
  300.          lreku = RESULT
  301.         'GETAREXXGADGET 'reqhandle' 'liff_gadget' CHECKED'
  302.          liff = RESULT
  303.         'GETAREXXGADGET 'reqhandle' 'lgif_gadget' CHECKED'
  304.          lgif = RESULT
  305.         'GETAREXXGADGET 'reqhandle' 'ljpeg_gadget' CHECKED'
  306.          ljpeg = RESULT
  307.         'GETAREXXGADGET 'reqhandle' 'ldr2d_gadget' CHECKED'
  308.          ldr2d = RESULT
  309.         'GETAREXXGADGET 'reqhandle' 'leps_gadget' CHECKED'
  310.          leps = RESULT
  311.         'GETAREXXGADGET 'reqhandle' 'laeeps_gadget' CHECKED'
  312.          laeeps = RESULT
  313.         'GETAREXXGADGET 'reqhandle' 'print_gadget' CHECKED'
  314.          print = RESULT
  315.  
  316.         'FREAREXXLIST 'rexxlist
  317.         'FREEAREXXREQUESTER 'reqhandle
  318.  
  319.         if (ergebnis = filehandler) then do
  320.             'GETFILEPATH TITLE "please choose the picture path" PATH "'pdir'"'
  321.             if (RC=0) then pdir = result
  322.         end
  323.         if (ergebnis = pprefshandler) then call PrintSettings
  324.     end
  325.     if (right(pdir,1) ~= ':') then
  326.         if (right(pdir,1) ~= '/') then pdir = pdir||'/'
  327. RETURN
  328.  
  329. DOERRORREQUESTER:
  330.     'ALLOCAREXXREQUESTER "Error!" 300 50'
  331.      reqhandle = RESULT
  332.     'ADDAREXXGADGET 'reqhandle' EXIT 115 30 70 LABEL "_Ok"'
  333.      dummy = RESULT
  334.  
  335.     'ADDAREXXGADGET 'reqhandle' TEXT 10 10 280 STRING "Please open a new document first!"'
  336.  
  337.     'DOAREXXREQUESTER 'reqhandle
  338.      dummy = RESULT
  339.  
  340.     'FREEAREXXREQUESTER 'reqhandle
  341.     exit
  342. RETURN
  343.  
  344. GETBUSY:
  345.     ARG messname
  346.     if (length(messname) > 27)
  347.     then mess = '...'||right(messname,25)
  348.     else mess = messname
  349.  
  350.     'SETBUSYREQUESTER 'BusyReq' MESSAGE "'mess'"'
  351.     'GETBUSYREQUESTER 'BusyReq
  352.     if (result=1) then do
  353.         if ((num // anzp) = 0) then do
  354.             'SELECTOBJECT ALL'
  355.             'DELETEOBJECT'
  356.             'DISPLAY PAGE PREVIOUS'
  357.         end
  358.         call CLEANUP
  359.     end
  360. RETURN
  361.  
  362. CLEANUP:
  363.     'CLOSEBUSYREQUESTER 'BusyReq
  364.     cl = Close('flist')
  365.     cl = Close('dlist')
  366.  
  367.     ADDRESS COMMAND 'C:Delete T:PicCatalog#?.tmp QUIET'
  368.  
  369.     'REFRESH ON'
  370.     'REFRESHWINDOW'
  371. EXIT
  372.  
  373. ReadPrefs:
  374.     ok = Open('Prefs','PageStream3:Scripts/PicCatalog.prefs','R')
  375.     if (ok = 1) then do
  376.         say 'reading old prefs...'
  377.         pdir = ReadLN('Prefs')
  378.         lreku = ReadLN('Prefs')
  379.         rleftgap = ReadLN('Prefs')
  380.         rtopgap = ReadLN('Prefs')
  381.         rrightgap = ReadLN('Prefs')
  382.         rbottomgap = ReadLN('Prefs')
  383.         rgap = ReadLN('Prefs')
  384.         numx = ReadLN('Prefs')
  385.         numy = ReadLN('Prefs')
  386.         rtxtsize = ReadLN('Prefs')
  387.         prname = ReadLN('Prefs')
  388.         liff = ReadLN('Prefs')
  389.         lgif = ReadLN('Prefs')
  390.         ljpeg = ReadLN('Prefs')
  391.         ldr2d = ReadLN('Prefs')
  392.         leps = ReadLN('Prefs')
  393.         laeeps = ReadLN('Prefs')
  394.         print = ReadLN('Prefs')
  395.         prmethod = ReadLN('Prefs')
  396.         prscale = ReadLN('Prefs')
  397.         cl = Close('Prefs')
  398.         end
  399.     else do
  400.         say 'unable to read prefs -> default values'
  401.         pdir = '!PLEASE TELL ME THE PICTURE PATH!'
  402.         lreku = 1
  403.         rleftgap = '1cm'
  404.         rtopgap = '1cm'
  405.         rrightgap = '1cm'
  406.         rbottomgap = '1cm'
  407.         rgap = '5mm'
  408.         numx = 3
  409.         numy = 4
  410.         rtxtsize = '10pt'
  411.         prname = 0
  412.         liff = 1
  413.         lgif = 1
  414.         ljpeg = 1
  415.         ldr2d = 1
  416.         leps = 1
  417.         laeeps = 1
  418.         print = 0
  419.         prmethod = 0
  420.         prscale = 0
  421.     end
  422. RETURN
  423.  
  424. WritePrefs:
  425.     ok = Open('Prefs','PageStream3:Scripts/PicCatalog.prefs','W')
  426.     if (ok = 1) then do
  427.         say 'writing prefs...'
  428.         WriteLN('Prefs',pdir)
  429.         WriteLN('Prefs',lreku)
  430.         WriteLN('Prefs',rleftgap)
  431.         WriteLN('Prefs',rtopgap)
  432.         WriteLN('Prefs',rrightgap)
  433.         WriteLN('Prefs',rbottomgap)
  434.         WriteLN('Prefs',rgap)
  435.         WriteLN('Prefs',numx)
  436.         WriteLN('Prefs',numy)
  437.         WriteLN('Prefs',rtxtsize)
  438.         WriteLN('Prefs',prname)
  439.         WriteLN('Prefs',liff)
  440.         WriteLN('Prefs',lgif)
  441.         WriteLN('Prefs',ljpeg)
  442.         WriteLN('Prefs',ldr2d)
  443.         WriteLN('Prefs',leps)
  444.         WriteLN('Prefs',laeeps)
  445.         WriteLN('Prefs',print)
  446.         WriteLN('Prefs',prmethod)
  447.         WriteLN('Prefs',prscale)
  448.         cl = Close('Prefs')
  449.         end
  450.     else do
  451.         say 'error writing prefs file "PicCatalog.prefs"'
  452.     end
  453. RETURN
  454.  
  455. DrawPageBorder:
  456.     d1 = leftgap - 5
  457.     d2 = topgap - 5
  458.     d3 = pagesizex-rightgap + 5
  459.     d4 = pagesizey-bottomgap + 5
  460.     'DRAWBOX 'd1||measure d2||measure d3||measure d4||measure
  461.     'SETSTROKEWEIGHT 5pt'
  462.  
  463.     d4 = d4 + 2
  464.     'DRAWTEXTOBJ 'd1||measure' 'd4||measure' INFRONT'
  465.      txtid = RESULT
  466.     'SELECTTEXT AT 'd1||measure' 'd4||measure' FRONTMOST'
  467.     bottomtxtsize = 12
  468.     bottompnum = (num % anzp) + 1
  469.     bottomtwidth = d3 - d1
  470.     'SETTYPESIZE "'bottomtxtsize||measure'"'
  471.     'INSERT "PicCatalog V2.03 - ©1996 Michael Merkel"'
  472.     'SETTABRULER "RIGHT" 'bottomtwidth||measure
  473.     'INSERTCONTROL TAB'
  474.     'INSERT "Page 'bottompnum'"'
  475. RETURN
  476.  
  477. RekDir:
  478.     PROCEDURE EXPOSE measure num numx numy anzp leftgap topgap rightgap pagesizex bottomgap pagesizey liff lgif ljpeg leps ldr2d laeeps psf psx psy gap txtsize lreku BusyReq print prname prmethod prscale
  479.     ARG dir
  480.  
  481.     ADDRESS COMMAND 'C:list dir="'||dir||'" LFORMAT="%F%N" FILES >T:PicCatalogFilesUS.tmp'
  482.  
  483.     if (GetLength('T:PicCatalogFilesUS.tmp') = 0)
  484.         then ADDRESS COMMAND 'C:Copy T:PicCatalogFilesUS.tmp TO T:PicCatalogFilesS.tmp'
  485.         else do
  486.             ADDRESS COMMAND 'C:Sort FROM T:PicCatalogFilesUS.tmp TO T:PicCatalogFilesS.tmp'
  487.             call WorkFileList
  488.         end
  489.     ADDRESS COMMAND 'C:Delete T:PicCatalogFilesUS.tmp T:PicCatalogFilesS.tmp QUIET'
  490.     if (lreku = 1) then do
  491.         ADDRESS COMMAND 'C:List dir="'||dir||'" LFORMAT="%F%N" DIRS >T:PicCatalogDirsUS.tmp'
  492.         if (GetLength('T:PicCatalogDirsUS.tmp') = 0)
  493.             then ADDRESS COMMAND 'C:Copy T:PicCatalogDirsUS.tmp TO T:PicCatalogDirsS.tmp'
  494.             else do
  495.                 ADDRESS COMMAND 'C:Sort FROM T:PicCatalogDirsUS.tmp TO T:PicCatalogDirsS.tmp'
  496.                 call WorkDirList
  497.             end
  498.     end
  499. RETURN 0
  500.  
  501. WorkFileList:
  502.     PROCEDURE EXPOSE measure num numx numy anzp leftgap topgap rightgap pagesizex bottomgap pagesizey liff lgif ljpeg leps ldr2d laeeps psf psx psy gap txtsize lreku BusyReq print prname prmethod prscale
  503.  
  504.     fnum = 0
  505.     if (Open('flist','t:PicCatalogFilesS.tmp','R') ~= 1) then do
  506.         say 'Fehler beim Öffnen des File-TmpFiles!!!'
  507.         exit
  508.     end
  509.  
  510.     do while (eof('flist') = 0)
  511.         named = readln('flist')
  512.         if (eof('flist') = 0) then do
  513.             name.fnum = named
  514.             fnum = fnum + 1
  515.         end
  516.     end
  517.     cl = Close('flist')
  518.  
  519.     do k = 0 to fnum-1
  520.         CALL AddPicture(name.k)
  521.     end
  522.  
  523. RETURN
  524.  
  525. WorkDirList:
  526.     PROCEDURE EXPOSE measure num numx numy anzp leftgap topgap rightgap pagesizex bottomgap pagesizey liff lgif ljpeg leps ldr2d laeeps psf psx psy gap txtsize lreku BusyReq print prname prmethod prscale
  527.  
  528.     ad = 0
  529.     if(Open('dlist','t:PicCatalogDirsS.tmp','R') ~= 1) then do
  530.         say 'Fehler beim Öffnen des DIR-TmpFiles!!!'
  531.         exit
  532.     end
  533.  
  534.     do while (eof('dlist') = 0)
  535.         name = readln('dlist')
  536.         if (eof('dlist') = 0) then do
  537.             dirname.ad = name
  538.             ad = ad + 1
  539.         end
  540.     end
  541.     cl = Close('dlist')
  542.  
  543.     ADDRESS COMMAND 'C:Delete T:PicCatalogDirsUS.tmp T:PicCatalogDirsS.tmp QUIET'
  544.  
  545.     do k = 0 to ad-1
  546.         call RekDir(dirname.k)
  547.     end
  548. RETURN
  549.  
  550. GetLength:
  551.     PROCEDURE EXPOSE BusyReq
  552.     ARG filename
  553.  
  554.     ADDRESS COMMAND 'C:List 'filename' LFORMAT="%l" >T:PicCatalogLength.tmp'
  555.     if (Open('flength','T:PicCatalogLength.tmp','R') = 1) then do
  556.         l = ReadLN('flength')
  557.         cl = Close('flength')
  558.         ADDRESS COMMAND 'C:Delete QUIET T:PicCatalogLength.tmp'
  559.         if (compare(l,'empty') = 0)
  560.             then return 0
  561.             else return l
  562.     end
  563.     else return 0
  564. RETURN ll
  565.  
  566. DumpText:
  567.     ARG dumptxt,dumpmode
  568.  
  569.     if (Open('dump','T:PicCatalog.dumpfile','A') = 1) then do
  570.         if dumpmode = 0 then wl = WriteCH('dump',dumptxt)
  571.         else                 wl = WriteLN('dump',dumptxt)
  572.         cl = Close('dump')
  573.     end
  574. RETURN
  575.  
  576. PrintPage:
  577.     output.0 = 'GRAYSCALE'
  578.     output.1 = 'COLOR'
  579.  
  580.     if (Open('dump','T:PicCatalog.dumpfile','A') = 1) then do
  581.         WriteLN('dump','printing page')
  582.         cl = Close('dump')
  583.     end
  584.  
  585.     if (prscale = 0) then do
  586.          'PRINTDOCUMENT PAGE "" OUTPUT 'output.prmethod' SCALE "ACTUAL"'
  587.     end
  588.     if (prscale = 1) then do
  589.          'PRINTDOCUMENT PAGE "" OUTPUT 'output.prmethod' SCALE "FULLPAGE"'
  590.     end
  591.  
  592.     'SELECTOBJECT ALL'
  593.     'DELETEOBJECT'
  594. RETURN
  595.  
  596. PrintSettings:
  597.     'ALLOCAREXXREQUESTER "Please set the settings for printing ..." 230 80'
  598.      reqhandle2 = RESULT
  599.     'ADDAREXXGADGET 'reqhandle2' EXIT 10  60 70 LABEL "_Ok"'
  600.      okhandler2 = RESULT
  601.     'ADDAREXXGADGET 'reqhandle2' EXIT 150 60 70 LABEL "_Cancel"'
  602.      cancelhandler2 = RESULT
  603.  
  604.     'ALLOCAREXXLIST'
  605.      rexxlist2 = RESULT
  606.     'ADDAREXXLIST 'rexxlist2' "Grayscale"'
  607.     'ADDAREXXLIST 'rexxlist2' "Color"'
  608.     'ADDAREXXGADGET 'reqhandle2' CYCLE 75 10 100 LABEL "Method:"'
  609.      prmethod_gadget = RESULT
  610.     'SETAREXXGADGET 'reqhandle2' 'prmethod_gadget' LIST 'rexxlist2' CURRENT 'prmethod
  611.  
  612.     'ALLOCAREXXLIST'
  613.      rexxlist3 = RESULT
  614.     'ADDAREXXLIST 'rexxlist3' "Actual Size"'
  615.     'ADDAREXXLIST 'rexxlist3' "Scale To Fit"'
  616.     'ADDAREXXGADGET 'reqhandle2' CYCLE 75 30 130 LABEL "Scale:"'
  617.      prscale_gadget = RESULT
  618.     'SETAREXXGADGET 'reqhandle2' 'prscale_gadget' LIST 'rexxlist3' CURRENT 'prscale
  619.  
  620.     'DOAREXXREQUESTER 'reqhandle2
  621.      ergebnis2 = RESULT
  622.  
  623.     'GETAREXXGADGET 'reqhandle2' 'prmethod_gadget' CURRENT'
  624.      prmethod_tmp = RESULT
  625.     'GETAREXXGADGET 'reqhandle2' 'prscale_gadget' CURRENT'
  626.      prscale_tmp = RESULT
  627.  
  628.     'FREAREXXLIST 'rexxlist2
  629.     'FREAREXXLIST 'rexxlist3
  630.     'FREEAREXXREQUESTER 'reqhandle2
  631.     if (ergebnis2 = okhandler) then do
  632.         prmethod = prmethod_tmp
  633.         prscale  = prscale_tmp
  634.     end
  635. RETURN
  636.